﻿'Imports Microsoft.Office.Interop.Word
Imports System
Imports System.IO

'TODO: Führen Sie diese Schritte aus, um das Element auf dem Menüband (XML) zu aktivieren:

'1: Kopieren Sie folgenden Codeblock in die ThisAddin-, ThisWorkbook- oder ThisDocument-Klasse.

'Protected Overrides Function CreateRibbonExtensibilityObject() As Microsoft.Office.Core.IRibbonExtensibility
'    Return New EBookWriter()
'End Function

'2. Erstellen Sie Rückrufmethoden im Abschnitt "Menübandrückrufe" dieser Klasse, um Benutzeraktionen
'   zu behandeln, zum Beispiel das Klicken auf eine Schaltfläche. Hinweis: Wenn Sie dieses Menüband aus dem
'   Menüband-Designer exportiert haben, verschieben Sie den Code aus den Ereignishandlern in die Rückrufmethoden, und
'   ändern Sie den Code für die Verwendung mit dem Programmiermodell für die Menübanderweiterung (RibbonX).

'3. Weisen Sie den Steuerelementtags in der Menüband-XML-Datei Attribute zu, um die entsprechenden Rückrufmethoden im Code anzugeben.

'Weitere Informationen erhalten Sie in der Menüband-XML-Dokumentation in der Hilfe zu Visual Studio-Tools für Office.

<Runtime.InteropServices.ComVisible(True)> _
Public Class EBookWriter
    Implements Office.IRibbonExtensibility

    Private ribbon As Office.IRibbonUI

    Public Sub New()
    End Sub

    Public Function GetCustomUI(ByVal ribbonID As String) As String Implements Office.IRibbonExtensibility.GetCustomUI
        Return GetResourceText("EBookWriter.EBookWriter.xml")
    End Function

#Region "Menübandrückrufe"
    'Erstellen Sie hier Rückrufmethoden. Weitere Informationen über das Hinzufügen von Rückrufmethoden erhalten Sie, indem Sie das Menüband-XML-Element im Projektmappen-Explorer markieren und dann F1 drücken.
    Public Sub Ribbon_Load(ByVal ribbonUI As Office.IRibbonUI)
        Me.ribbon = ribbonUI
    End Sub

    Public Sub OnButtonPress(ByVal control As Office.IRibbonControl)
        System.Windows.Forms.MessageBox.Show("Button clicked !")

        ' read word object structure
        Dim document As Microsoft.Office.Interop.Word.Document = Globals.ThisAddIn.Application.ActiveDocument

        Dim newDocument As MyDocument = readWordDocument(document)


        'Dialog "Speichern unter" aufrufen und Dateinamen vorgeben
        'Application.Dialogs(xlDialogSaveAs).Show("Ebook")

        Dim Writer1 As New Writer
        ' Writer1.writeHtmlTest()
        Writer1.writeHtml("testbuchreal", newDocument)
    End Sub

#End Region

#Region "Hilfsprogramme"

    Private Shared Function GetResourceText(ByVal resourceName As String) As String
        Dim asm As Reflection.Assembly = Reflection.Assembly.GetExecutingAssembly()
        Dim resourceNames() As String = asm.GetManifestResourceNames()
        For i As Integer = 0 To resourceNames.Length - 1
            If String.Compare(resourceName, resourceNames(i), StringComparison.OrdinalIgnoreCase) = 0 Then
                Using resourceReader As IO.StreamReader = New IO.StreamReader(asm.GetManifestResourceStream(resourceNames(i)))
                    If resourceReader IsNot Nothing Then
                        Return resourceReader.ReadToEnd()
                    End If
                End Using
            End If
        Next
        Return Nothing
    End Function

#End Region

    Function rgbIntToHex(ByVal int As Integer) As String
        int = int And 16777215 ' sorgt dafür, dass nur die hintersten 24 Stellen (oder 6 wenn hexadezimal) behalten werden
        Dim retVal As String = int.ToString("X")
        For i As Integer = retVal.Length To 6
            retVal = "0" & retVal
        Next

        Return retVal
    End Function


    Function readWordDocument(ByVal Doc As Word.Document) As MyDocument

        'Dim objWriter As New System.IO.StreamWriter("D:\documentTest.txt")

        Dim numOfParagraphs As Integer = Doc.Paragraphs.Count()
        Dim myDocument As New MyDocument(numOfParagraphs)
        Dim myParagraph As MyParagraph
        Dim mySentence As MySentence
        Dim paragraphIndex As Integer = 0

        ' ## Bilder behandeln
        'Dim sourceFolderName As String = "D:\"
        Dim sourceFile As String = "D:\TeamTest\tempFile.docx"
        Dim destFolder As String = "D:\TeamTest"

        If Directory.Exists(destFolder) = False Then
            Directory.CreateDirectory(destFolder)
        End If

        Doc.SaveAs2(sourceFile)

        ' ## Formate abspeichern
        Dim formFields As Word.FormFields = Doc.FormFields

        '#Dim shell As Object = CreateObject("Shell.Application")
        '#shell.Namespace(destFolder).CopyHere(shell.Namespace(sourceFile).items)


        For Each paragraph As Word.Paragraph In Doc.Paragraphs

            myDocument.paragraphs(paragraphIndex) = New MyParagraph(paragraph.Range.Sentences.Count)
            myParagraph = myDocument.paragraphs(paragraphIndex)
            Dim sentenceIndex As Integer = 0

            If paragraph.Range.Characters.Count = 1 AndAlso (AscW(paragraph.Range.Text) = 13) Then ' leerer Paragraph; einziges Zeichen: <carriage return>
                myParagraph.empty = True
                paragraphIndex += 1
                Continue For
            End If

            'Dim inlineShapes As Word.InlineShapes = Doc.InlineShapes
            'For Each picture As Word.InlineShape In inlineShapes
            'Dim type As Word.WdInlineShapeType = picture.Type
            'Dim name As String = picture.Title
            'Next

            ' Hier werden Bilder gefunden, die "Zeilenumbruch->passend" haben
            Dim shapes As Word.Shapes = Doc.Shapes
            For Each shape As Word.Shape In shapes

                Dim name As String = shape.Name
                ' Dim title As String = shape.Title
            Next

            For Each sentence As Word.Range In paragraph.Range.Sentences

                myParagraph.sentences(sentenceIndex) = New MySentence(sentence.Words.Count)
                mySentence = myParagraph.sentences(sentenceIndex)
                Dim formats As New Dictionary(Of MyFormat, Integer)

                'Formats:
                'Searching for the predominant format
                For Each word As Word.Range In sentence.Words

                    Dim found As Boolean = False    ' true, if the word has an format which is already in "formats"
                    Dim pairValue = 1               ' amount of words which have a shared format
                    Dim highestValue = 0            ' highest value of all pairValues
                    Dim newFormat As New MyFormat(word.Font.Name, word.Font.Size, word.Font.Bold, word.Font.Italic, (word.Font.Underline > 0), rgbIntToHex(word.Font.TextColor.RGB))

                    ' searching if newFormat is already in "formats"
                    ' if found, removing it from "formats" and increasing pairValue by 1.
                    For Each pair In formats
                        If newFormat.isEqual(pair.Key) Then
                            pairValue = pair.Value + 1
                            formats.Remove(pair.Key)
                            found = True
                            Exit For
                        End If
                    Next

                    formats.Add(newFormat, pairValue)
                    If highestValue < pairValue Then
                        mySentence.commonFormat = myDocument.indexByFormat(newFormat)
                        highestValue = pairValue
                    End If

                Next

                Dim wordIndex As Integer = 0

                For Each word As Word.Range In sentence.Words

                    If (AscW(word.Text.Substring(0, 1))) > 32 Then
                        mySentence.words(wordIndex) = word.Text
                        wordIndex += 1
                    ElseIf AscW(word.Text.Substring(0, 1)) = 9 Then 'Tabulator
                        mySentence.words(wordIndex) = ""
                        mySentence.specialChars.Add(wordIndex, "<TAB>")
                        wordIndex += 1
                    End If

                    Dim newFormat As New MyFormat(word)
                    If Not (newFormat.isEqual(myDocument.globalFormats(mySentence.commonFormat))) Then
                        Dim sIndex As Integer = myDocument.indexByFormat(newFormat)
                        If sIndex <> -1 Then
                            mySentence.specialFormat.Add(wordIndex - 1, myDocument.indexByFormat(newFormat))
                        End If
                    End If
                Next

                mySentence.cleanArray()
                sentenceIndex += 1
            Next

            paragraphIndex += 1
        Next

        Return myDocument

        'objWriter.Close()
        'objWriter.Dispose()

    End Function



End Class
